/*
 *  eval.c
 *  scheme2
 *
 *  Created by Leo Katzenstein on 5/26/07.
 *  Copyright 2007 __MyCompanyName__. All rights reserved.
 *
 */

#include "scheme.h"

/*
 * Evaluate a symbol by looking it up in the environment.
 */
Pair *evsym( Pair *sym, Pair *env )
{
	Pair *p, *e;
	for ( e = env; e; e = e->cdr )
	{
		for ( p = e->car; p; p = p->cdr )
			if ( p->car->car == sym )
				return p->car->cdr;
	}
	pexp( sym );  /* need pname function */
	error( "attempt to take the value of an unbound variable" );
	return NULL;  /* not reached, quiet the warning */
}

/*
 * Evaluate a (progn e1 e2 ... en)
 * The evaluation is done by successively evaluating each of
 * ei and returning the value of en.
 * 
 * A major use for this is if the e1 through e(i-1) have side
 * effects.
 *
 * The parameters are:
 *   l, the list of remaining clauses,
 *   a, the value of the last clause evaluated, and
 *   env, the environment.
 */
Pair *evprogn( Pair *l, Pair *a, Pair *env )
{
  if ( NULL == l )
    return a;
  a = eval( l->car, env );
  return evprogn( l->cdr, a, env );
}

/*
 * Cond is relatively complex compared to the other primitives
 * so for clarity the evaluation is separated out.
 *
 * cl is the list of cond clauses, each clause of the form
 * (p e1 e2 ... en). p is evaluated and if non-nil then each
 * of e1 through en is evaluated in turn, and the result
 * returned is the value of en.
 * If there are no terms e1 ... then the value returned is the
 * value of p.
 * If none of the clauses is selected nil is returned.
 */
Pair *evcond( Pair *cl, Pair *env )
{
  Pair *pv;          /* predicate value */
  if ( NULL == cl )
    return cl;

  /*
   * Evaluate the first expression in the first clause.
   *
   * If the result is NULL, then evaluate the remaining clauses.
   * Otherwise, the predicate evaluates to some non-null value,
   * so evaluate the expressions in the remainder of the clause.
   * This evaluation is essentially an evaluation of (progn ...).
   */

  pv = eval( cl->car->car, env );
  if ( NULL == pv )
    return evcond( cl->cdr, env );
  else
    return evprogn( cl->car->cdr, pv, env );
  
}

Pair *eval( Pair *exp, Pair *env )
{
	Pair *f, *a, *v;
	/* case by case */
	
	/* nil */
	if ( exp == NULL )
	  return exp;
	/* nil is really quite special */
	if ( exp == nil )
	  return NULL;

	/* number - numbers evaluate to themselves */
	if ( is_number( exp ) )
	  return exp;

	/* symbol - get the value from the atom (environment later) */
	if ( is_symbol( exp ) )
	  return evsym( exp, env );

	/* combination */

	/* check for the special operators first */

	if ( exp->car == quote ) {         /* quote */
	  return CADR(exp);
	} else if ( exp->car == cond ) {   /* cond  */
	  return evcond(exp->cdr, env);
	} else if ( exp->car == define )   /* define */
	  return setf( CADR(exp), eval( CADDR(exp), env ), env );
	else if ( exp->car == lambda ) {
	  return make_lambda( exp->cdr, env );
	}
	f = eval( exp->car, env );
	a = evlist( exp->cdr, env );
	v = apply( f, a, env );
	return v;
}

Pair *evlist( Pair *l, Pair *env )
{
	Pair *p;
	if ( l == NULL )
		return l;
	p = new( Pair );
	p->car = eval( l->car, env );
	p->cdr = evlist( l->cdr, env );
	return p;
}

Pair *apply( Pair *f, Pair *argl, Pair *env )
{
	Pair *v;
	Pair *e1;
	
	if ( is_func( f ) )
		v = (*( (PF) f->cdr))( argl );
	else if ( is_lambda(f) ) {
		v = pairlis( CADDR(f), argl );
		e1 = cons( v, env );
		return eval( f->cdr->cdr->cdr->car, e1 );
	} else 
		error( "don't know how to apply function" );
	return v;
}
